home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / rendezvous.tst < prev    next >
Text File  |  1992-05-19  |  1KB  |  69 lines
  1. .( Loading Multi-tasking rendezvous test...) cr
  2.  
  3. #include multi-tasking.f83
  4.  
  5. multi-tasking 
  6.  
  7. .( 1: A simple server task that performs the service one-plus) cr
  8.  
  9. RENDEZVOUS service ( n -- m)
  10.  
  11. 16 16 task.type SERVER
  12. task.body
  13.   begin
  14.     accept service ( arg -- res)
  15.       1+
  16.     accept.end
  17.   again
  18. task.end
  19.  
  20. SERVER aServer
  21.  
  22.  
  23. .( 2: A multiple read buffer with services put and get) cr
  24.  
  25. RENDEZVOUS put ( n -- nil)
  26. RENDEZVOUS get ( nil -- n)
  27.  
  28. 16 16 task.type BUFFER
  29.   long item
  30. task.body
  31.   accept put ( item -- nil)
  32.     item ! nil
  33.   accept.end
  34.   begin
  35.     ?awaiting put if
  36.       accept put ( item -- nil)
  37.     item ! nil
  38.       accept.end
  39.     then
  40.     ?awaiting get if
  41.       accept get ( nil -- item)
  42.     drop item @
  43.       accept.end
  44.     then
  45.     detach
  46.   again
  47. task.end
  48.  
  49. BUFFER aBuffer
  50.  
  51.  
  52. .( 3: A demon task which feed the two other tasks with calls) cr
  53.  
  54. 16 16 task.type DEMON
  55. task.body
  56.   begin
  57.     nil get service put drop
  58.   again
  59. task.end
  60.  
  61. DEMON aDemon
  62.  
  63.  
  64. .( 4: Initiate the buffer and run the scenario) cr
  65.  
  66. 0 put drop 10000 delay 0 get . cr
  67.  
  68. forth only
  69.